Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/xceedzip/ZIPMANAG.BAS

BASIC Source File | 1999-04-26 | 8.2 KB | 206 lines

Attribute VB_Name = "modZipManager"
Option Explicit

' Constants used by the sample application to determine
' the characteristics of Open Dialog

Public Const OpenZip = 0
Public Const NewZip = 1
Public Const SelectBin = 5
Public Const ChooseFiles = 6

' Constants used to determine the command executed by the
' ExecuteSelFilesCmd function

Public Const SF_Delete = 0
Public Const SF_Extract = 1

'------------------------------------------------------------------------------------
' This function returns a string representing the files attributes. It's used in
' the listing of an zip file's content in the main window.
'------------------------------------------------------------------------------------
Public Function Attributes(lAttr As Long) As String
    Dim sRes As String

    If (lAttr And xfaArchive) > 0 Then sRes = sRes + "A" Else sRes = sRes + "-"
    If (lAttr And xfaCompressed) > 0 Then sRes = sRes + "C" Else sRes = sRes + "-"
    If (lAttr And xfaFolder) > 0 Then sRes = sRes + "D" Else sRes = sRes + "-"
    If (lAttr And xfaHidden) > 0 Then sRes = sRes + "H" Else sRes = sRes + "-"
    If (lAttr And xfaReadOnly) > 0 Then sRes = sRes + "R" Else sRes = sRes + "-"
    If (lAttr And xfaSystem) > 0 Then sRes = sRes + "S" Else sRes = sRes + "-"
    If (lAttr And xfaVolume) > 0 Then sRes = sRes + "V" Else sRes = sRes + "-"

    Attributes = sRes
End Function

'------------------------------------------------------------------------------------
' This function counts the number of files in the list of files
' of the type returned by the SelectFilesToProcess function.
'------------------------------------------------------------------------------------
Public Function CountFilesInList(ByVal FileList As String) As Integer
   Dim Count As Integer
   Dim Pos As Integer

   Count = 0
   For Pos = 1 To Len(FileList)
      If Mid$(FileList, Pos, 1) = Chr(0) Then Count = Count + 1
   Next Pos

   If Count = 0 Then Count = 1

   CountFilesInList = Count
End Function

'------------------------------------------------------------------------------------
' This function takes a list of files of the type that is returned by
' the SelectFilesToProcess function, and returns a single file (with
' pathname).
'------------------------------------------------------------------------------------

Public Function GetFileFromList(ByVal FileList As String, FileNumber As Integer) As String
   Dim Pos As Integer
   Dim Count As Integer
   Dim FNStart As Integer
   Dim FNLen As Integer
   Dim Path As String

   If InStr(FileList, Chr(0)) = 0 Then
      GetFileFromList = FileList
   Else
      Count = 0
      Path = Left(FileList, InStr(FileList, Chr(0)) - 1)
      If Right(Path, 1) <> "\" Then Path = Path + "\"
      FileList = FileList + Chr(0) 'Addition de Chr(0) a la place de ""
      For Pos = 1 To Len(FileList)
         If Mid$(FileList, Pos, 1) = Chr(0) Then
            Count = Count + 1
            If Count = FileNumber Then FNStart = Pos + 1
            If Count = (FileNumber + 1) Then
               FNLen = Pos - FNStart
               Exit For
            End If
         End If
      Next Pos
      GetFileFromList = Path + Mid(FileList, FNStart, FNLen)
   End If
End Function

'------------------------------------------------------------------------------------
' Identify the files read in the windows Dialog box. The window Dialog box
' returns a string of paths separated by a NULL caracter
'------------------------------------------------------------------------------------
Public Function IdentifyFiles(Files As String) As String
    Dim FileNum As Integer
    Dim ListFiles As String
    Dim FileName As String

    For FileNum = 1 To CountFilesInList(Files)
             FileName = GetFileFromList$(ByVal Files, FileNum)
             ListFiles = ListFiles + FileName + vbCrLf
   Next FileNum

   IdentifyFiles = ListFiles
End Function

'------------------------------------------------------------------------------------
' Reads a ListItem object and returns a string of filenames separated
' by a line feed. When the user selects multiple files from the list
' and then clicks on Remove or Extract, the returned string will be used in
' the FilesToProcess property.
'------------------------------------------------------------------------------------
Public Function GetSelectedFiles(ListFiles As ListItems, UseBasePath As Boolean) As String
    Dim counter             As Integer
    Dim iNbSelected         As Integer
    Dim sFilesToProcess     As String

    sFilesToProcess = ""
    If ListFiles.Count > 0 Then
        For counter = 1 To ListFiles.Count Step 1
            If (ListFiles.Item(counter).Selected) Then
                If ListFiles.Item(counter) = "<dir>" Then
                    sFilesToProcess = sFilesToProcess + ListFiles.Item(counter).SubItems(9) + "\" + vbCrLf
                ElseIf UseBasePath Then
                    sFilesToProcess = sFilesToProcess + ListFiles.Item(counter).SubItems(9) + "\" + ListFiles.Item(counter) + vbCrLf
                Else
                    sFilesToProcess = sFilesToProcess + ListFiles.Item(counter) + vbCrLf
                End If
            End If
        Next counter
    End If
    GetSelectedFiles = sFilesToProcess
End Function

'------------------------------------------------------------------------------------
' This function opens up an 'Open File' Dialog to have the
' user select a zip file. Depending on the DialogType parameter,
' the behavior of the dialog is different.
'
' This function will return the full path and filename of the
' selected zip file. If the Cancel button was used, then the
' function will return an empty string.
'------------------------------------------------------------------------------------
Public Function SelectZipFile(DialogType As Integer) As String

   With frmMain.dlgSelectZip

      .FileName = ""
      .Flags = cdlOFNFileMustExist + cdlOFNNoChangeDir + cdlOFNHideReadOnly
      .Filter = "Zip files (*.zip)|*.zip|Self-extracting zip files (*.exe)|*.exe|All files (*.*)|*.*"
      .MaxFileSize = 32000

      Select Case DialogType
         Case OpenZip
            .DialogTitle = "Open Zip File"
            .Action = 1
         Case NewZip
            .Flags = cdlOFNOverwritePrompt + cdlOFNNoChangeDir + cdlOFNHideReadOnly
            .DialogTitle = "New Zip File"
            .Action = 2  ' Pretend we are saving a file. The new zip file is really only created when you start zipping files into it.
         Case SelectBin
            .FileName = ""
            .Filter = "Self-extractor binary (*.bin)|*.bin|All files (*.*)|*.*"
            .DialogTitle = "Select self-extractor binary"
            .Action = 1
        Case ChooseFiles
            .FileName = "*.*"
            .DialogTitle = "Select files to process"
            .Flags = 0
            .Flags = cdlOFNFileMustExist + cdlOFNNoChangeDir + cdlOFNHideReadOnly + cdlOFNExplorer + cdlOFNAllowMultiselect + cdlOFNLongNames
            .Filter = "All Files|*.*"
            .Action = 1
      End Select

      SelectZipFile = .FileName
   End With

End Function

'------------------------------------------------------------------------------------
' This function prevents the user from entering caracters in a field. It's
' used with dates and numerical values controls.
'------------------------------------------------------------------------------------
Public Function ValidateNumbers(key As Integer) As Integer
    Select Case key
    Case 8, Asc("0") To Asc("9")        ' The 8th character is the Backspace key
        ValidateNumbers = key
    Case Else
        ValidateNumbers = 0
    End Select
End Function

'------------------------------------------------------------------------------------
' Search backward in a string for a character
'------------------------------------------------------------------------------------
Public Function InStrRev(sString As String, sChar As String)
    Dim i As Integer

    For i = Len(sString) To 1 Step -1
        If Mid(sString, i, 1) = sChar Then
            InStrRev = i
            Exit Function
        End If
    Next i

    InStrRev = 0
End Function